home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / basic / vect.zip / 3DEXP2.BAS next >
BASIC Source File  |  1992-06-04  |  13KB  |  436 lines
  1. '3DEXP2.BAS By Rich Geldreich June 2nd, 1992
  2. 'A fast, QuickBASIC 4.5 3-D wireframe animation program.
  3. 'Compile it for maximum speed!
  4. 'If you have any questions or ideas, please write/call:
  5.  
  6. 'Rich Geldreich
  7. '410 Market St.
  8. 'Gloucester City, NJ 08030
  9. '(609)-742-8752
  10.  
  11. 'The following program is in the public domain! Have fun!
  12. 'Also look at VECT.ASM
  13. DEFINT A-Z
  14. TYPE LineType
  15.     X AS INTEGER
  16.     Y AS INTEGER
  17.     Z AS INTEGER
  18.     X1 AS INTEGER
  19.     Y1 AS INTEGER
  20.     Z1 AS INTEGER
  21. END TYPE
  22. DIM Points(100) AS LineType
  23. DIM Xn(100), Yn(100), Zn(100)
  24. DIM Xs1(100), Ys1(100), Xe1(100), Ye1(100)
  25. DIM X(100), Y(100), Z(100), Pointers1(100), Pointers2(100), Sp(100), Zp(100)
  26. DIM R(100), B(63), B1(63)
  27. DIM Cosine&(360), Sine&(360)
  28. CLS
  29. PRINT "3-D Craft v1a"
  30. PRINT "By Rich Geldreich June 2nd, 1992"
  31. PRINT
  32. PRINT "Keys to use: (Turn NUMLOCK on!)"
  33. PRINT "Q...............Quits"
  34. PRINT "Numeric keypad..Controls your position(press 5 on the keypad"
  35. PRINT "                to completly stop yourself) "
  36. PRINT "-...............Forward exceleration"
  37. PRINT "+...............Backward exceleration"
  38. PRINT "Arrow keys......Controls the rotation of the craft"
  39. PRINT "F...............Excelerates the craft (Forward)"
  40. PRINT "B...............Slows the craft (Backward)"
  41. PRINT "S...............Stops the craft"
  42. PRINT "A...............Toggles Auto Center, use this when you lose";
  43. PRINT " the craft"
  44. PRINT "C...............Stops the craft's rotation"
  45. PRINT "V...............Resets the craft to starting position"
  46. PRINT
  47. PRINT "Wait a sec..."
  48.  
  49. 'The following for/next loop makes a sine & cosine table.
  50. 'Each sine & cosine is multiplied by 1024 and stored as long integers.
  51. 'This is done so that we don't have to use any slow floating point
  52. 'math at run time.
  53. A = 0
  54. FOR A! = 0 TO 359 / 57.29577951# STEP 1 / 57.29577951#
  55.     Cosine&(A) = INT(.5 + COS(A!) * 1024)
  56.     Sine&(A) = INT(.5 + SIN(A!) * 1024): A = A + 1
  57. NEXT
  58. 'Next we read in all of the lines that are in the object...
  59. FOR A = 0 TO 44
  60.     READ Points(A).X, Points(A).Y, Points(A).Z
  61.     READ Points(A).X1, Points(A).Y1, Points(A).Z1
  62. NEXT
  63. 'Here comes the hard part... Consider this scenario:
  64.  
  65. 'We have two connected lines, like this:
  66.  
  67. '   1--------2 and 3
  68. '            |
  69. '            |
  70. '            |
  71. '            |
  72. '            4
  73. 'Where 1,2, 3, & 4 are the starting and ending points of each line.
  74. 'The first line consists of points 1 & 2  and the second line
  75. 'is made of points 3 & 4.
  76. 'So, you ask, what's wrong? Nothing, really, but don't you see that
  77. 'points 2 and 3 are really at the sample place? Why rotate them twice,
  78. 'that would be a total waste of time? The following code eliminates such
  79. 'occurrences from the line table. (great explanation, huh?)
  80.  
  81. NumberLines = 45
  82. 'take all of the starting & ending points and put them in one big
  83. 'array...
  84. Np = 0
  85. FOR A = 0 TO NumberLines - 1
  86.     X(Np) = Points(A).X
  87.     Y(Np) = Points(A).Y
  88.     Z(Np) = Points(A).Z
  89.     Np = Np + 1
  90.     X(Np) = Points(A).X1
  91.     Y(Np) = Points(A).Y1
  92.     Z(Np) = Points(A).Z1
  93.     Np = Np + 1
  94. NEXT
  95. 'Now set up two sets of pointers that point to each point that a line
  96. 'is made of... (in other words, scan for the first occurrence of each
  97. 'starting and ending point in the point array we just built...)
  98. FOR A = 0 TO NumberLines - 1
  99.     Xs = Points(A).X
  100.     Ys = Points(A).Y
  101.     Zs = Points(A).Z            'get the 3 coordinates of the start point
  102.     FOR B = 0 TO Np - 1         'scan the point array
  103.         IF X(B) = Xs AND Y(B) = Ys AND Z(B) = Zs THEN
  104.             Pointers1(A) = B    'set the pointer to point to the
  105.             EXIT FOR            'point we have just found
  106.         END IF
  107.     NEXT
  108.     Xs = Points(A).X1           'do the same thing that we did above
  109.     Ys = Points(A).Y1           'except scan for the ending point
  110.     Zs = Points(A).Z1           'of each line
  111.     FOR B = 0 TO Np - 1
  112.         IF X(B) = Xs AND Y(B) = Ys AND Z(B) = Zs THEN
  113.             Pointers2(A) = B
  114.             EXIT FOR
  115.         END IF
  116.     NEXT
  117. NEXT
  118. 'Okay, were almost done! All we have to do now is to build a table
  119. 'that tells us which points to actually rotate...
  120. Nr = 0
  121. FOR A = 0 TO NumberLines - 1
  122.     F1 = Pointers1(A)   'get staring & ending point number
  123.     S1 = Pointers2(A)
  124.     IF Nr = 0 THEN      'if this is the first point then it of course
  125.                         'has to be rotated
  126.         R(Nr) = F1: Nr = Nr + 1
  127.     ELSE
  128.         Found = 0       'scan to see if this point already exists...
  129.         FOR B = 0 TO Nr - 1
  130.             IF R(B) = F1 THEN
  131.                 Found = -1: EXIT FOR    'shoot, it's already here!
  132.             END IF
  133.         NEXT
  134.         IF NOT Found THEN R(Nr) = F1: Nr = Nr + 1   'point the point
  135.                                                     'in the array it we
  136.     END IF                                          'can't find it...
  137.         
  138.     Found = 0   'now look for the ending point
  139.     FOR B = 0 TO Nr - 1
  140.         IF R(B) = S1 THEN
  141.             Found = -1: EXIT FOR
  142.         END IF
  143.     NEXT
  144.     IF NOT Found THEN R(Nr) = S1: Nr = Nr + 1
  145. NEXT
  146. FOR A = 0 TO 63
  147.     B(A) = (4 * A) \ 8
  148.     B1(A) = A - B(A)
  149. NEXT
  150. PRINT "Press any key to begin..."
  151. A$ = INPUT$(1)
  152.  
  153. Deg1 = 0: Deg2 = 0: D1 = 0: D2 = 0
  154.  
  155. Spos = -200: Mypos = 0
  156.  
  157. Mx = 0: My = 0: Mz = 0: Ox = 0: Oy = 0: Oz = -260
  158.  
  159. NumberOfFrames = 0
  160. DEF SEG = &H40
  161. StartTime = PEEK(&H6C)
  162.  
  163. SCREEN 13
  164. FOR A = 0 TO 63
  165.     OUT &H3C7, A: OUT &H3C8, A: OUT &H3C9, A: OUT &H3C9, 0: OUT &H3C9, 0
  166. NEXT
  167.  
  168. DO
  169.  
  170.  
  171.     
  172.     Deg1 = (Deg1 + D1) MOD 360
  173.     Deg2 = (Deg2 + D2) MOD 360
  174.     IF Deg1 < 0 THEN Deg1 = Deg1 + 360
  175.     IF Deg2 < 0 THEN Deg2 = Deg2 + 360
  176.    
  177.     C1& = Cosine&(Deg1): S1& = Sine&(Deg1)
  178.     C2& = Cosine&(Deg2): S2& = Sine&(Deg2)
  179.     C3& = Cosine&(Deg3): S3& = Sine&(Deg3)
  180.     'Deg3 = (Deg3 + 5) MOD 360
  181.    
  182.     X = Speed: Y = 0: Z = 0
  183.  
  184.     X1 = (X * C1&) \ 1024: Y1 = (X * S1&) \ 1024
  185.     X2 = (X1 * C2&) \ 1024: Zn = (X1 * S2&) \ 1024
  186.    
  187.     Y3 = (Y1 * C3& - Zn * S3&) \ 1024
  188.     Z3 = (Y1 * S3& + Zn * C3&) \ 1024
  189.    
  190.     Ox = Ox + X2: Oy = Oy + Y3: Oz = Oz + Z3
  191.     IF Oz > 32000 THEN Oz = 32000
  192.     IF Oz < -32000 THEN Oz = -32000
  193.     IF Ox > 32000 THEN Ox = 32000
  194.     IF Ox < -32000 THEN Ox = -32000
  195.     IF Oy > 32000 THEN Oy = 32000
  196.     IF Oy < -32000 THEN Oy = -32000
  197.    
  198.     
  199.     IF AtLoc THEN
  200.         Mx = Mx + (Ox - Mx) \ 4
  201.         My = My + (Oy - My) \ 4
  202.         Mz = Mz + ((Oz + 200) - Mz) \ 4
  203.     ELSE
  204.         'adjust the users position based on how much he is moving...
  205.         Mz = Mz + Mzm: Mx = Mx + Mxm: My = My + Mym
  206.         IF Mz > 32000 THEN Mz = 32000
  207.         IF Mz < -32000 THEN Mz = -32000
  208.         IF Mx > 32000 THEN Mx = 32000
  209.         IF Mx < -32000 THEN Mx = -32000
  210.         IF My > 32000 THEN My = 32000
  211.         IF My < -32000 THEN My = -32000
  212.     END IF
  213.    
  214.     LOCATE 1, 1: PRINT A$
  215.     
  216.     MaxZ = -32768
  217.     LowZ = 32767
  218.     FOR A = 0 TO Nr - 1
  219.         R = R(A)
  220.         Xo = X(R): Yo = Y(R): Zo = Z(R)
  221.         
  222.         X1 = (Xo * C1& - Yo * S1&) \ 1024
  223.         Y1 = (Xo * S1& + Yo * C1&) \ 1024
  224.        
  225.         X2& = (X1 * C2& - Zo * S2&) \ 1024 - Mx + Ox
  226.         Z2 = (X1 * S2& + Zo * C2&) \ 1024
  227.         
  228.         Y3& = (Y1 * C3& - Z2 * S3&) \ 1024 - My + Oy
  229.         Z4 = (Y1 * S3& + Z2 * C3&) \ 1024
  230.         
  231.         Z3 = Z4 - Mz + Oz
  232.        
  233.  
  234.         Zn(R) = Z4
  235.         IF Z4 > MaxZ THEN MaxZ = Z4
  236.         IF Z4 < LowZ THEN LowZ = Z4
  237.        
  238.         'X2&,Y3&,Z3
  239.  
  240.         'if the point is too close(or behind) the viewer then
  241.         'don't draw it...
  242.         IF (Mypos - Z3) < 15 THEN
  243.             Xn(R) = -1000: Yn(R) = 0: Zn = 0
  244.         ELSE
  245.             V = (1330& * (Spos - Z3)) \ (Mypos - Z3)
  246.             Xn(R) = 160 + X2& + (-X2& * V) \ 1330
  247.             Yn(R) = 100 + (8 * (Y3& + (-Y3& * V) \ 1330)) \ 10
  248.         END IF
  249.     NEXT
  250.        
  251.     MaxZ = MaxZ - LowZ
  252.    
  253.        
  254.     Nl = 0
  255.     FOR A = 0 TO NumberLines - 1
  256.         F1 = Pointers1(A): S1 = Pointers2(A)
  257.         IF Xn(F1) <> -1000 AND Xn(S1) <> -1000 THEN
  258.             Sp(Nl) = A
  259.             Zp(A) = (Zn(F1) + Zn(S1)) \ 2
  260.             Nl = Nl + 1
  261.         END IF
  262.     NEXT
  263.     Nl = Nl - 1
  264.     'sort lines according to their Z coordinates  
  265.     IF Nl > -1 THEN
  266.         Mid = Nl \ 2
  267.         DO
  268.             FOR A = 0 TO Nl - Mid
  269.                 IF Zp(Sp(A)) > Zp(Sp(A + Mid)) THEN
  270.                     SWAP Sp(A), Sp(A + Mid)
  271.                     CL = A - Mid
  272.                     CH = A
  273.                     DO WHILE CL >= 0
  274.                         IF Zp(Sp(CL)) > Zp(Sp(CH)) THEN
  275.                             SWAP Sp(CL), Sp(CH)
  276.                             CH = CL
  277.                             CL = CL - Mid
  278.                         ELSE
  279.                             EXIT DO
  280.                         END IF
  281.                     LOOP
  282.                 END IF
  283.             NEXT
  284.             Mid = Mid \ 2
  285.         LOOP WHILE Mid > 0
  286.     END IF
  287.     'wait for vertical retrace
  288.     WAIT &H3DA, 8
  289.     'erase old points
  290.     FOR A = Ln - 1 TO 0 STEP -1
  291.         LINE (Xs1(A), Ys1(A))-(Xe1(A), Ye1(A)), 0
  292.     NEXT
  293.    
  294.     Ln = 0
  295.     FOR A1 = 0 TO Nl
  296.         A = Sp(A1)
  297.        
  298.         Z = Zp(A)
  299.         F1 = Pointers1(Sp(A1)): S1 = Pointers2(Sp(A1))
  300.        
  301.         Xn = Xn(F1): Yn = Yn(F1)
  302.         
  303.         IF Xn <> -1000 THEN
  304.             X1 = Xn(S1)
  305.             IF X1 <> -1000 THEN
  306.                 Y1 = Yn(S1)
  307.                 Z1 = (Z - Mz + Oz)
  308.                 
  309.                 IF Z1 > -1500 THEN
  310.                     'calculate color
  311.                     T = 63 - ((Z1 * -63&) \ 1500)
  312.                     C = B1(T) + (B(T) * (Z - LowZ)) \ MaxZ
  313.                     'draw line   
  314.                     LINE (X1, Y1)-(Xn, Yn), C
  315.                     'store for later                  
  316.                     Xs1(Ln) = X1: Ys1(Ln) = Y1
  317.                     Xe1(Ln) = Xn: Ye1(Ln) = Yn
  318.                     Ln = Ln + 1
  319.                 END IF
  320.             END IF
  321.         END IF
  322.     NEXT
  323.     'process keystroke 
  324.     K$ = UCASE$(INKEY$)
  325.     'Process the keystroke(if any)...
  326.     IF K$ <> "" THEN
  327.         SELECT CASE K$
  328.             CASE "A"
  329.                 AtLoc = NOT AtLoc
  330.             CASE "+"
  331.                 Mzm = Mzm + 2
  332.             CASE "-"
  333.                 Mzm = Mzm - 2
  334.             CASE "5"
  335.                 Mxm = 0: Mym = 0: Mzm = 0
  336.             CASE "4"
  337.                 Mxm = Mxm - 2
  338.             CASE "6"
  339.                 Mxm = Mxm + 2
  340.             CASE "8"
  341.                 Mym = Mym - 2
  342.             CASE "2"
  343.                 Mym = Mym + 2
  344.             CASE "F"
  345.                 Speed = Speed + 5
  346.             CASE "B"
  347.                 Speed = Speed - 5
  348.             CASE "C"
  349.                 D1 = 0: D2 = 0
  350.             CASE "S"
  351.                 Speed = 0
  352.             CASE CHR$(0) + CHR$(72)
  353.                 D1 = D1 + 1
  354.             CASE CHR$(0) + CHR$(80)
  355.                 D1 = D1 - 1
  356.             CASE CHR$(0) + CHR$(75)
  357.                 D2 = D2 - 1
  358.             CASE CHR$(0) + CHR$(77)
  359.                 D2 = D2 + 1
  360.             CASE "Q", CHR$(27)
  361.                 SCREEN 0, , 0, 0: WIDTH 80
  362.                 CLS
  363.                 PRINT "By Rich Geldreich June 2nd, 1992"
  364.                 PRINT "See ya later!"
  365.                 END
  366.             CASE "V"
  367.                 D1 = 0: D2 = 0: Deg1 = 0: Deg2 = 0: Speed = 0
  368.         END SELECT
  369.     END IF
  370.     NumberOfFrames = NumberOfFrames + 1
  371.     'see if 20 frames have passed; if so then see
  372.     'how long it took...
  373.     IF NumberOfFrames = 20 THEN
  374.         TotalTime = PEEK(&H6C) - StartTime
  375.         IF TotalTime < 0 THEN TotalTime = TotalTime + 256
  376.         FramesPerSecX100 = 36400 \ TotalTime
  377.         High = FramesPerSecX100 \ 100
  378.         Low = FramesPerSecX100 - High
  379.         'A$ has the string that is printed at the upper left
  380.         'corner of the screen
  381.         A$ = MID$(STR$(High), 2) + "."
  382.         A$ = A$ + RIGHT$("0" + MID$(STR$(Low), 2), 2) + "  "
  383.         NumberOfFrames = 0
  384.         StartTime = PEEK(&H6C)
  385.     END IF
  386. LOOP
  387. 'The following data is the shuttle craft...
  388. 'stored as Start X,Y,Z & End X,Y,Z
  389. DATA -157,22,39,-157,-18,39
  390. DATA -157,-18,39,-127,-38,39
  391. DATA -127,-38,39,113,-38,39
  392. DATA 113,-38,39,193,12,39
  393. DATA 33,42,39,33,42,-56
  394. DATA 33,42,-56,-127,42,-56
  395. DATA -127,42,-56,-157,22,-56
  396. DATA -157,22,-56,-157,22,39
  397. DATA -157,22,-56,-157,-18,-56
  398. DATA -157,-18,-56,-157,-18,39
  399. DATA -157,-18,-56,-127,-38,-56
  400. DATA -127,-38,-56,-127,-38,39
  401. DATA -127,-38,-56,113,-38,-56
  402. DATA 113,-38,-56,113,-38,39
  403. DATA 113,-38,-56,193,12,-56
  404. DATA 193,12,-56,193,12,39
  405. DATA -157,22,-56,193,12,-56
  406. DATA 193,12,39,-157,22,39
  407. DATA -56,-13,41,-56,-3,41
  408. DATA -56,-3,41,-26,-3,41
  409. DATA -26,-3,41,-26,7,41
  410. DATA -51,7,41,-31,-13,41
  411. DATA -11,-13,41,-11,-3,41
  412. DATA -11,-3,41,-1,7,41
  413. DATA 9,7,41,9,-8,41
  414. DATA 9,-8,41,24,-8,41
  415. DATA 34,16,41,34,-38,41
  416. DATA 33,-39,41,33,-39,-53
  417. DATA 33,-39,-53,33,15,-53
  418. DATA -42,-38,19,-72,-38,19
  419. DATA -72,-38,19,-72,-38,-41
  420. DATA -72,-38,-41,-42,-38,-41
  421. DATA -42,-38,-41,-42,-38,19
  422. DATA 33,42,39,34,16,41
  423. DATA 33,42,-56,33,15,-53
  424. DATA -157,22,39,-127,42,39
  425. DATA -127,42,-56,-127,42,39
  426. DATA -127,42,39,33,42,39
  427. DATA 159,-8,-56,159,-8,40
  428. DATA 143,-18,-56,143,-18,39
  429. DATA 193,12,39,193,32,30
  430. DATA 33,42,39,193,32,30
  431. DATA 193,32,30,193,32,-47
  432. DATA 33,42,-56,193,32,-47
  433. DATA 193,12,-56,193,32,-47
  434.  
  435.  
  436.